home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / CONVRSC.M < prev    next >
Encoding:
Text File  |  1989-03-10  |  3.3 KB  |  118 lines
  1. MODULE ConvRsc;
  2.  
  3. (*
  4.  * Wandelt Output File v. K-Resouce um.
  5.  *)
  6.  
  7. FROM Files IMPORT Open, Close, Create, Access, File, EOF, State,GetStateMsg,
  8.                 ReplaceMode;
  9. FROM Text IMPORT Read, ReadString, ReadLn, WriteString, WriteLn, EOL;
  10. FROM Strings IMPORT String, Pos, Concat, Insert, Compare, Relation,
  11.   Upper, Length, PosLen, Copy, Delete;
  12. IMPORT InOut;
  13. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  14.  
  15. PROCEDURE err (f:File): BOOLEAN;
  16.   VAR msg: String; ch:CHAR;
  17.   BEGIN
  18.     IF State (f)< 0 THEN
  19.       InOut.GotoXY (0,20);
  20.       InOut.WriteString ('Error !');
  21.       InOut.WriteLn;
  22.       GetStateMsg (State(f),msg);
  23.       InOut.WriteString (msg);
  24.       InOut.WriteLn;
  25.       InOut.Read (ch);
  26.       RETURN TRUE
  27.     ELSE
  28.       RETURN FALSE
  29.     END
  30.   END err;
  31.  
  32. PROCEDURE clearLine;
  33.   BEGIN
  34.     InOut.Write (33C);
  35.     InOut.Write ('l');
  36.   END clearLine;
  37.  
  38. PROCEDURE letter (ch:CHAR): BOOLEAN;
  39.   BEGIN
  40.     RETURN (ch>='a') & (ch<='z')
  41.   END letter;
  42.  
  43. VAR in, out: File;
  44.     pos1,i,line: CARDINAL;
  45.     j:INTEGER;
  46.     up, export, const, press, ok: BOOLEAN;
  47.     l: String;
  48.     ch: CHAR;
  49.  
  50. BEGIN
  51.   InOut.WritePg;
  52.   
  53.   InOut.GotoXY (0,2);
  54.   InOut.WriteString ('line:');
  55.   Open (in,'MSHELL.DEF',readSeqTxt);
  56.   IF err (in) THEN RETURN END;
  57.   Create (out,'MSHELL.D',writeSeqTxt,replaceOld);
  58.   IF err (out) THEN RETURN END;
  59.   line := 1;
  60.   export:= FALSE;
  61.   const:= FALSE;
  62.   LOOP
  63.     InOut.CondRead (ch,press);
  64.     IF press & (ch=33C) THEN EXIT END;
  65.     ReadString (in,l);
  66.     IF EOF (in) THEN IF err (in) THEN RETURN END; EXIT END;
  67.     (* TABs durch SPACE ersetzen *)
  68.     LOOP j:=Pos (11C,l,0); IF j<0 THEN EXIT END; l[j] := ' ' END;
  69.     j:= Pos ('Mshell',l,0);
  70.     IF j >= 0 THEN
  71.       Insert ('D',j+6,l,ok);
  72.       l[j+1]:=CAP(l[j+1])
  73.     END;
  74.     j:= Pos (' QUALIFIED',l,0);
  75.     IF Pos ('END',l,0) = 0 THEN
  76.       const:= FALSE
  77.     ELSIF j>0 THEN
  78.       Delete (l,j,10,ok);
  79.       export:= TRUE
  80.     ELSIF Pos ('CONST',l,0) >= 0 THEN
  81.       const:= TRUE
  82.     ELSIF export THEN
  83.       up:= TRUE;
  84.       FOR i:= 0 TO Length (l) DO
  85.         ch:= l[i];
  86.         IF letter(ch) & up THEN
  87.           l[i]:= CAP (ch);
  88.           up:= FALSE
  89.         ELSIF ch=',' THEN
  90.           up:= TRUE
  91.         ELSIF ch=';' THEN
  92.           export:= FALSE
  93.         END
  94.       END
  95.     ELSIF const THEN
  96.       i:= 0;
  97.       WHILE (i<Length (l)) & ~letter (l[i]) DO INC (i) END;
  98.       IF i<Length (l) THEN
  99.         l[i]:= CAP (l[i])
  100.       END
  101.     END;
  102.     WriteString (out,l);
  103.     IF EOL (in) THEN
  104.       WriteLn (out);
  105.       InOut.GotoXY (6,2);
  106.       InOut.WriteCard (line,0);
  107.       INC (line);
  108.       IF err (out) THEN RETURN END;
  109.     END
  110.   END;
  111.   Close (out);
  112.   IF err (out) THEN RETURN END;
  113.   Close (in);
  114.   IF err (in) THEN RETURN END;
  115. END ConvRsc.
  117. (* $FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF7AA40$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6$FFF142E6Ç$000006FET.......T.......T.......T.......T......TT.......T.......T.......T.......T.......$00000219$00000498$00000A19$FFF7AA40$FFF7AA40$000006DC$000006CD$000006D9$000006BB$0000069E$000006BB$FFF7AA40$000006DA$000006FE$000006DD$000006D9ÕÇÇ*)
  118.